home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue43 / makemic / DIRLIST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-09-23  |  4.7 KB  |  162 lines
  1. unit Dirlist;
  2.  
  3. { This unit defines the various versions of ScanDir called from MAKEMIU.PAS    }
  4. { when each of the 4 start buttons are clicked. It makes use of $IFDEFs to     }
  5. { tailor the unit to the Delphi version.                                       }
  6.  
  7. interface
  8.  
  9. uses SysUtils;
  10.  
  11. type
  12. { TScanDirCallBack is defined with the pascal calling convention for Win32.    }
  13. { The 16 bit version does not specify this keyword as it is invalid in that    }
  14. { environment and all parameters are passed on the stack.                      }
  15.  
  16. {$IFNDEF WIN32}
  17.   TScanDirCallBack = function(CurrentFile: string; Attr: Byte): Boolean;
  18. {$ELSE}
  19.   TScanDirCallBack = function(CurrentFile: string; Attr: Byte): Boolean; pascal;
  20.  
  21. { These three callbacks are used to demonstrate how MakeMethodInstance32Reg    }
  22. { handles routines with 1,2 or 3 parameters optimised into registers           }
  23.  
  24.   TScanDirCallBackR1 = function(CurrentFile: string): Boolean;
  25.   TScanDirCallBackR2 = function(CurrentFile: string; Attr: Byte): Boolean;
  26.   TScanDirCallBackR3 = function(CurrentFile: string; Attr: Byte; Size: Integer): Boolean;
  27. {$ENDIF}
  28.  
  29. function ScanDir(const Dir: string; CallBack: TScanDirCallBack): Integer;
  30. {$IFDEF WIN32}
  31. function ScanDirR1(const Dir: string; CallBack: TScanDirCallBackR1): Integer;
  32. function ScanDirR2(const Dir: string; CallBack: TScanDirCallBackR2): Integer;
  33. function ScanDirR3(const Dir: string; CallBack: TScanDirCallBackR3): Integer;
  34. {$ENDIF}
  35.  
  36. implementation
  37.  
  38. function ScanDir(const Dir: string; CallBack: TScanDirCallBack): Integer;
  39. var
  40.   SearchRec: TSearchRec;
  41.   RC: Integer;
  42.   WStr: string;
  43.   Cancelled: Boolean;
  44.  
  45. begin
  46.   Result := 0;
  47.   Cancelled := False;
  48.   if Dir[Length(Dir)] = '\' then
  49.     WStr := Dir + '*.*'
  50.   else
  51.     WStr := Dir + '\*.*';
  52.   RC := FindFirst(WStr,faAnyFile,SearchRec);
  53.   While (RC = 0) and not Cancelled do
  54.     begin
  55.       if SearchRec.Attr <> faVolumeId then
  56.         begin
  57.           Inc(Result);
  58.           if Assigned(CallBack) then
  59.             Cancelled := CallBack(SearchRec.Name,SearchRec.Attr);
  60.         end;
  61.       RC := FindNext(SearchRec);
  62.     end;
  63. end;
  64.  
  65. {$IFDEF WIN32}
  66.  
  67. { The following functions were defined to demonstrate how                      }
  68. { MskeMethodInstance32Reg handles the register calling convention              }
  69.  
  70. { This routine accepts a callback which is defined so that a single            }
  71. { parameter is optimised into registers (Name)                                 }
  72.  
  73. function ScanDirR1(const Dir: string; CallBack: TScanDirCallBackR1): Integer;
  74. var
  75.   SearchRec: TSearchRec;
  76.   RC: Integer;
  77.   WStr: string;
  78.   Cancelled: Boolean;
  79.  
  80. begin
  81.   Result := 0;
  82.   Cancelled := False;
  83.   if Dir[Length(Dir)] = '\' then
  84.     WStr := Dir + '*.*'
  85.   else
  86.     WStr := Dir + '\*.*';
  87.   RC := FindFirst(WStr,faAnyFile,SearchRec);
  88.   While (RC = 0) and not Cancelled do
  89.     begin
  90.       if SearchRec.Attr <> faVolumeId then
  91.         begin
  92.           Inc(Result);
  93.           if Assigned(CallBack) then
  94.             Cancelled := CallBack(SearchRec.Name);
  95.         end;
  96.       RC := FindNext(SearchRec);
  97.     end;
  98. end;
  99.  
  100. { This routine accepts a callback which is defined so that two                 }
  101. { parameters are optimised into registers (Name and Attr)                      }
  102.  
  103. function ScanDirR2(const Dir: string; CallBack: TScanDirCallBackR2): Integer;
  104. var
  105.   SearchRec: TSearchRec;
  106.   RC: Integer;
  107.   WStr: string;
  108.   Cancelled: Boolean;
  109.  
  110. begin
  111.   Result := 0;
  112.   Cancelled := False;
  113.   if Dir[Length(Dir)] = '\' then
  114.     WStr := Dir + '*.*'
  115.   else
  116.     WStr := Dir + '\*.*';
  117.   RC := FindFirst(WStr,faAnyFile,SearchRec);
  118.   While (RC = 0) and not Cancelled do
  119.     begin
  120.       if SearchRec.Attr <> faVolumeId then
  121.         begin
  122.           Inc(Result);
  123.           if Assigned(CallBack) then
  124.             Cancelled := CallBack(SearchRec.Name,SearchRec.Attr);
  125.         end;
  126.       RC := FindNext(SearchRec);
  127.     end;
  128. end;
  129.  
  130. { This routine accepts a callback which is defined so that three               }
  131. { parameters are optimised into registers (Name,Attr and size)                 }
  132.  
  133. function ScanDirR3(const Dir: string; CallBack: TScanDirCallBackR3): Integer;
  134. var
  135.   SearchRec: TSearchRec;
  136.   RC: Integer;
  137.   WStr: string;
  138.   Cancelled: Boolean;
  139.  
  140. begin
  141.   Result := 0;
  142.   Cancelled := False;
  143.   if Dir[Length(Dir)] = '\' then
  144.     WStr := Dir + '*.*'
  145.   else
  146.     WStr := Dir + '\*.*';
  147.   RC := FindFirst(WStr,faAnyFile,SearchRec);
  148.   While (RC = 0) and not Cancelled do
  149.     begin
  150.       if SearchRec.Attr <> faVolumeId then
  151.         begin
  152.           Inc(Result);
  153.           if Assigned(CallBack) then
  154.             Cancelled := CallBack(SearchRec.Name,SearchRec.Attr,SearchRec.Size);
  155.         end;
  156.       RC := FindNext(SearchRec);
  157.     end;
  158. end;
  159. {$ENDIF}
  160.  
  161. end.
  162.